{3}{$D-,W+}PROGRAM DVITYPE(DVIFILE,OUTPUT);LABEL{4}9999;
CONST{5}MAXFONTS=100;MAXWIDTHS=10000;LINELENGTH=80;TERMINALLINE=150;
STACKSIZE=100;NAMESIZE=1000;NAMELENGTH=50;TYPE{7}ASCIICODE=32..126;
{8}TEXTFILE=PACKED FILE OF CHAR;{18}EIGHTBITS=0..255;
BYTEFILE=PACKED FILE OF EIGHTBITS;VAR{9}XORD:ARRAY[CHAR]OF ASCIICODE;
XCHR:ARRAY[ASCIICODE]OF CHAR;{19}DVIFILE:BYTEFILE;TFMFILE:BYTEFILE;
{21}CURLOC:INTEGER;CURNAME:PACKED ARRAY[1..NAMELENGTH]OF CHAR;
{22}B0,B1,B2,B3:EIGHTBITS;{27}FONTNUM:ARRAY[0..MAXFONTS]OF INTEGER;
FONTNAME:ARRAY[0..MAXFONTS]OF 0..NAMESIZE;
NAMES:ARRAY[0..NAMESIZE]OF ASCIICODE;
FONTSPACE:ARRAY[0..MAXFONTS]OF INTEGER;
FONTBC:ARRAY[0..MAXFONTS]OF INTEGER;FONTEC:ARRAY[0..MAXFONTS]OF INTEGER;
WIDTHBASE:ARRAY[0..MAXFONTS]OF 0..MAXWIDTHS;
WIDTH:ARRAY[0..MAXWIDTHS]OF INTEGER;NF:0..MAXFONTS;
WIDTHPTR:0..MAXWIDTHS;{30}INWIDTH:ARRAY[0:255]OF INTEGER;
TFMCHECKSUM:INTEGER;{36}PIXELWIDTH:ARRAY[0..MAXWIDTHS]OF INTEGER;
CONV:REAL;{38}OUTMODE:0..2;MAXPAGES:INTEGER;RESOLUTION:REAL;
NEWMAG:INTEGER;{39}STARTCOUNT:ARRAY[0..9]OF INTEGER;
STARTTHERE:ARRAY[0..9]OF BOOLEAN;STARTVALS:0..9;
COUNT:ARRAY[0..9]OF INTEGER;
{42}BUFFER:ARRAY[0..TERMINALLINE]OF ASCIICODE;
{45}BUFPTR:0..TERMINALLINE;{54}TEXTPTR:0..LINELENGTH;
TEXTBUF:ARRAY[1..LINELENGTH]OF ASCIICODE;{59}H,V,W,X,Y,Z,HH,VV:INTEGER;
HSTACK,VSTACK,WSTACK,XSTACK,YSTACK,ZSTACK:ARRAY[0..STACKSIZE]OF INTEGER;
HHSTACK,VVSTACK:ARRAY[0..STACKSIZE]OF INTEGER;{60}MAXV:INTEGER;
MAXH:INTEGER;MAXSTACKDEPT:INTEGER;{63}CURFONT:INTEGER;SHOWING:BOOLEAN;
{81}PAGECOUNT:INTEGER;PSTLOC:INTEGER;STARTLOC:INTEGER;
{83}K,M,N,P,Q,R:INTEGER;{95}DEFAULTDIREC:PACKED ARRAY[1:9]OF CHAR;
PROCEDURE INITIALIZE;VAR I:INTEGER;
BEGIN WRITELN('This is DVItype, Version 0');{10}XCHR[32]:=' ';
XCHR[33]:='!';XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';XCHR[37]:='%';
XCHR[38]:='&';XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';XCHR[42]:='*';
XCHR[43]:='+';XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';XCHR[47]:='/';
XCHR[48]:='0';XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';XCHR[52]:='4';
XCHR[53]:='5';XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';XCHR[57]:='9';
XCHR[58]:=':';XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';XCHR[62]:='>';
XCHR[63]:='?';XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';XCHR[67]:='C';
XCHR[68]:='D';XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';XCHR[72]:='H';
XCHR[73]:='I';XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';XCHR[77]:='M';
XCHR[78]:='N';XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';XCHR[82]:='R';
XCHR[83]:='S';XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';XCHR[87]:='W';
XCHR[88]:='X';XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';XCHR[92]:='\';
XCHR[93]:=']';XCHR[94]:='↑';XCHR[95]:='_';XCHR[96]:='`';XCHR[97]:='a';
XCHR[98]:='b';XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';
XCHR[102]:='f';XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';
XCHR[106]:='j';XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';
XCHR[110]:='n';XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';
XCHR[114]:='r';XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';
XCHR[118]:='v';XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';
XCHR[122]:='z';XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';
XCHR[126]:='~';{11}FOR I:=0 TO 127 DO XORD[CHR(I)]:=32;
FOR I:=32 TO 126 DO XORD[XCHR[I]]:=I;{28}NF:=0;WIDTHPTR:=0;
FONTNAME[0]:=0;{40}OUTMODE:=2;MAXPAGES:=1000000;STARTVALS:=0;
STARTTHERE[0]:=FALSE;{55}TEXTPTR:=0;{96}DEFAULTDIREC:='[TEX,SYS]';END;
{20}PROCEDURE OPENDVIFILE;BEGIN RESET(DVIFILE,'','/B:8');CURLOC:=0;END;
PROCEDURE OPENTFMFILE;BEGIN RESET(TFMFILE,CURNAME,'/B:8/O/N:19');END;
{23}PROCEDURE READTFMWORD;BEGIN READ(TFMFILE,B0);READ(TFMFILE,B1);
READ(TFMFILE,B2);READ(TFMFILE,B3);END;{24}FUNCTION GETBYTE:INTEGER;
VAR B:EIGHTBITS;
BEGIN IF EOF(DVIFILE)THEN GETBYTE:=0 ELSE BEGIN READ(DVIFILE,B);
CURLOC:=CURLOC+1;GETBYTE:=B;END;END;FUNCTION SIGNEDBYTE:INTEGER;
VAR B:EIGHTBITS;BEGIN READ(DVIFILE,B);CURLOC:=CURLOC+1;
IF B<128 THEN SIGNEDBYTE:=B ELSE SIGNEDBYTE:=B-256;END;
FUNCTION GETTWOBYTES:INTEGER;VAR A,B:EIGHTBITS;BEGIN READ(DVIFILE,A);
READ(DVIFILE,B);CURLOC:=CURLOC+2;GETTWOBYTES:=A*256+B;END;
FUNCTION SIGNEDPAIR:INTEGER;VAR A,B:EIGHTBITS;BEGIN READ(DVIFILE,A);
READ(DVIFILE,B);CURLOC:=CURLOC+2;
IF A<128 THEN SIGNEDPAIR:=A*256+B ELSE SIGNEDPAIR:=(A-256)*256+B;END;
FUNCTION GETTHREEBYTE:INTEGER;VAR A,B,C:EIGHTBITS;BEGIN READ(DVIFILE,A);
READ(DVIFILE,B);READ(DVIFILE,C);CURLOC:=CURLOC+3;
GETTHREEBYTE:=(A*256+B)*256+C;END;FUNCTION SIGNEDTRIO:INTEGER;
VAR A,B,C:EIGHTBITS;BEGIN READ(DVIFILE,A);READ(DVIFILE,B);
READ(DVIFILE,C);CURLOC:=CURLOC+3;
IF A<128 THEN SIGNEDTRIO:=(A*256+B)*256+C ELSE SIGNEDTRIO:=((A-256)*256+
B)*256+C;END;FUNCTION SIGNEDQUAD:INTEGER;VAR A,B,C,D:EIGHTBITS;
BEGIN READ(DVIFILE,A);READ(DVIFILE,B);READ(DVIFILE,C);READ(DVIFILE,D);
CURLOC:=CURLOC+4;
IF A<128 THEN SIGNEDQUAD:=((A*256+B)*256+C)*256+D ELSE SIGNEDQUAD:=(((A
-256)*256+B)*256+C)*256+D;END;{25}FUNCTION DVILENGTH:INTEGER;
BEGIN SETPOS(DVIFILE,-1);DVILENGTH:=CURPOS(DVIFILE);END;
PROCEDURE MOVETOBYTE(N:INTEGER);BEGIN SETPOS(DVIFILE,N);CURLOC:=N;END;
{29}PROCEDURE PRINTFONT(F:INTEGER);VAR K:0..NAMESIZE;
BEGIN IF F=NF THEN WRITE('undefined font!')ELSE BEGIN FOR K:=FONTNAME[F]
TO FONTNAME[F+1]-1 DO WRITE(XCHR[NAMES[K]]);END;END;
{31}FUNCTION INTFM(Z:INTEGER):BOOLEAN;LABEL 9997,9998,9999;
VAR K:INTEGER;LH:INTEGER;NW:INTEGER;WP:0..MAXWIDTHS;ALPHA,BETA:INTEGER;
BEGIN{32}READTFMWORD;LH:=B2*256+B3;READTFMWORD;FONTBC[NF]:=B0*256+B1;
FONTEC[NF]:=B2*256+B3;
IF FONTEC[NF]<FONTBC[NF]THEN FONTBC[NF]:=FONTEC[NF]+1;
IF WIDTHPTR+FONTEC[NF]-FONTBC[NF]+1>MAXWIDTHS THEN BEGIN WRITELN(
'---not loaded, DVItype needs larger width table');GOTO 9998;END;
WP:=WIDTHPTR+FONTEC[NF]-FONTBC[NF]+1;READTFMWORD;NW:=B0*256+B1;
IF(NW=0)OR(NW>256)THEN GOTO 9997;
FOR K:=1 TO 3+LH DO BEGIN IF EOF(TFMFILE)THEN GOTO 9997;READTFMWORD;
IF K=4 THEN IF B0<128 THEN TFMCHECKSUM:=((B0*256+B1)*256+B2)*256+B3 ELSE
TFMCHECKSUM:=(((B0-256)*256+B1)*256+B2)*256+B3;END;;
{33}IF WP>0 THEN FOR K:=WIDTHPTR TO WP-1 DO BEGIN READTFMWORD;
IF B0>NW THEN GOTO 9997;WIDTH[K]:=B0;END;;{34}{35}BEGIN ALPHA:=16*Z;
BETA:=16;WHILE Z>=8388608 DO BEGIN Z:=Z DIV 2;BETA:=BETA DIV 2;END;END;
FOR K:=0 TO NW-1 DO BEGIN READTFMWORD;
INWIDTH[K]:=(((((B3*Z)DIV 256)+(B2*Z))DIV 256)+(B1*Z))DIV BETA;
IF B0>0 THEN IF B0<255 THEN GOTO 9997 ELSE INWIDTH[K]:=INWIDTH[K]-ALPHA;
END;{37}WIDTHBASE[NF]:=WIDTHPTR-FONTBC[NF];
IF WP>0 THEN FOR K:=WIDTHPTR TO WP-1 DO BEGIN WIDTH[K]:=INWIDTH[WIDTH[K]
];PIXELWIDTH[K]:=TRUNC(CONV*(WIDTH[K])+0.5);END;WIDTHPTR:=WP;
INTFM:=TRUE;GOTO 9999;9997:WRITELN('---not loaded, TFM file is bad');
9998:INTFM:=FALSE;9999:END;{41}FUNCTION STARTMATCH:BOOLEAN;VAR K:0..9;
MATCH:BOOLEAN;BEGIN MATCH:=TRUE;
FOR K:=0 TO STARTVALS DO IF STARTTHERE[K]AND(STARTCOUNT[K]<>COUNT[K])
THEN MATCH:=FALSE;STARTMATCH:=MATCH;END;{44}PROCEDURE INPUTLN;
VAR K:0..TERMINALLINE;BEGIN BREAK(TTY);RESET(TTY);
IF EOLN(TTY)THEN READLN(TTY);K:=0;
WHILE(K<TERMINALLINE)AND NOT EOLN(TTY)DO BEGIN BUFFER[K]:=XORD[TTY↑];
K:=K+1;GET(TTY);END;BUFFER[K]:=32;END;{46}FUNCTION GETINTEGER:INTEGER;
VAR X:INTEGER;NEGATIVE:BOOLEAN;
BEGIN IF BUFFER[BUFPTR]=45 THEN BEGIN NEGATIVE:=TRUE;BUFPTR:=BUFPTR+1;
END ELSE NEGATIVE:=FALSE;X:=0;
WHILE(BUFFER[BUFPTR]>=48)AND(BUFFER[BUFPTR]<=57)DO BEGIN X:=10*X+BUFFER[
BUFPTR]-48;BUFPTR:=BUFPTR+1;END;
IF NEGATIVE THEN GETINTEGER:=-X ELSE GETINTEGER:=X;END;
{47}PROCEDURE DIALOG;LABEL 1,2,3,4,5;VAR K:INTEGER;BEGIN REWRITE(TTY);
{48}1:WRITE(TTY,'Output level (default=2, ? for help): ');OUTMODE:=2;
INPUTLN;
IF BUFFER[0]<>32 THEN IF(BUFFER[0]>=48)AND(BUFFER[0]<=50)THEN OUTMODE:=
BUFFER[0]-48 ELSE BEGIN WRITE(TTY,'Type 2 for complete listing,');
WRITE(TTY,' 0 for errors only,');
WRITELN(TTY,' 1 for something in between.');GOTO 1;END;
{49}2:WRITE(TTY,'Starting page (default=*): ');STARTVALS:=0;
STARTTHERE[0]:=FALSE;INPUTLN;BUFPTR:=0;K:=0;
IF BUFFER[0]<>32 THEN REPEAT IF BUFFER[BUFPTR]=42 THEN BEGIN STARTTHERE[
K]:=FALSE;BUFPTR:=BUFPTR+1;END ELSE BEGIN STARTTHERE[K]:=TRUE;
STARTCOUNT[K]:=GETINTEGER;END;
IF(K<9)AND(BUFFER[BUFPTR]=46)THEN BEGIN K:=K+1;BUFPTR:=BUFPTR+1;
END ELSE IF BUFFER[BUFPTR]=32 THEN STARTVALS:=K ELSE BEGIN WRITE(TTY,
'Type, e.g., 1.*.-5 to specify the ');
WRITELN(TTY,'first page with \count0=1, \count2=-5.');GOTO 2;END;
UNTIL STARTVALS=K;
{50}3:WRITE(TTY,'Maximum number of pages (default=1000000): ');
MAXPAGES:=1000000;INPUTLN;BUFPTR:=0;
IF BUFFER[0]<>32 THEN BEGIN MAXPAGES:=GETINTEGER;
IF MAXPAGES<=0 THEN BEGIN WRITELN(TTY,'Please type a positive number.');
GOTO 3;END;END;{51}4:WRITE(TTY,'Assumed device resolution');
WRITE(TTY,' in pixels per inch (default=240/1): ');RESOLUTION:=240.0;
INPUTLN;BUFPTR:=0;IF BUFFER[0]<>32 THEN BEGIN K:=GETINTEGER;
IF(K>0)AND(BUFFER[BUFPTR]=47)AND(BUFFER[BUFPTR+1]>48)AND(BUFFER[BUFPTR+1
]<=57)THEN BEGIN BUFPTR:=BUFPTR+1;RESOLUTION:=K/GETINTEGER;
END ELSE BEGIN WRITE(TTY,'Type a ratio of positive integers;');
WRITELN(TTY,' (1 pixel per mm would be 254/10).');GOTO 4;END;END;
{52}5:WRITE(TTY,'New magnification (default=0): ');NEWMAG:=0;INPUTLN;
BUFPTR:=0;
IF BUFFER[0]<>32 THEN IF(BUFFER[0]>=48)AND(BUFFER[0]<=57)THEN NEWMAG:=
GETINTEGER ELSE BEGIN WRITE(TTY,'Type a positive integer to override ');
WRITELN(TTY,'the magnification in the DVI file.');GOTO 5;END;
{53}WRITELN('Options selected:');WRITE('  Starting page = ');
FOR K:=0 TO STARTVALS DO BEGIN IF STARTTHERE[K]THEN WRITE(STARTCOUNT[K]:
0)ELSE WRITE('*');IF K<STARTVALS THEN WRITE('.')ELSE WRITELN(' ');END;
WRITELN('  Maximum number of pages = ',MAXPAGES:0);
WRITE('  Output level = ',OUTMODE:0);
CASE OUTMODE OF 0:WRITELN(' (showing bops and error messages only)');
1:WRITELN(' (terse)');2:WRITELN(' (verbose)');END;
WRITELN('  Resolution = ',RESOLUTION:12:8,' pixels per inch');
IF NEWMAG>0 THEN WRITELN('  New magnification factor = ',NEWMAG/1000:8:3
);END;{56}PROCEDURE FLUSHTEXT;VAR K:0..LINELENGTH;
BEGIN IF TEXTPTR>0 THEN BEGIN IF OUTMODE>0 THEN BEGIN WRITE('[');
FOR K:=1 TO TEXTPTR DO WRITE(XCHR[TEXTBUF[K]]);WRITELN(']');END;
TEXTPTR:=0;END;END;{57}PROCEDURE OUTTEXT(C:ASCIICODE);
BEGIN IF TEXTPTR=LINELENGTH-2 THEN FLUSHTEXT;TEXTPTR:=TEXTPTR+1;
TEXTBUF[TEXTPTR]:=C;END;{61}FUNCTION FIRSTPAR(O:EIGHTBITS):INTEGER;
BEGIN CASE O OF 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,
46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,
70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,
94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,
113,114,115,116,117,118,119,120,121,122,123,124,125,126,127:FIRSTPAR:=O
-0;128,133,235,239:FIRSTPAR:=GETBYTE;129,134,236:FIRSTPAR:=GETTWOBYTES;
130,135,237:FIRSTPAR:=GETTHREEBYTE;
143,148,153,157,162,167:FIRSTPAR:=SIGNEDBYTE;
144,149,154,158,163,168:FIRSTPAR:=SIGNEDPAIR;
145,150,155,159,164,169:FIRSTPAR:=SIGNEDTRIO;
131,132,136,137,146,151,156,160,165,170,238:FIRSTPAR:=SIGNEDQUAD;
138,139,140,141,142,240,241,242,243,244,245,246,247,248,249,250,251,252,
253,254,255:FIRSTPAR:=0;147:FIRSTPAR:=W;152:FIRSTPAR:=X;161:FIRSTPAR:=Y;
166:FIRSTPAR:=Z;
171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,
189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,
207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,
225,226,227,228,229,230,231,232,233,234:FIRSTPAR:=O-171;END;END;
{62}FUNCTION RULEPIXELS(X:INTEGER):INTEGER;VAR N:INTEGER;
BEGIN N:=TRUNC(CONV*X);
IF N<CONV*X THEN RULEPIXELS:=N+1 ELSE RULEPIXELS:=N;END;
{65}FUNCTION DOOTHERS(O:EIGHTBITS;P:INTEGER;A:INTEGER):BOOLEAN;
LABEL 44,9998,30;VAR Q:INTEGER;
BEGIN{69}CASE O OF 133,134,135,136:BEGIN IF OUTMODE>0 THEN BEGIN
FLUSHTEXT;SHOWING:=TRUE;WRITE(A:0,': ','put',O-132:0,' ',P:0);END;
GOTO 30;END;
{72}157,158,159,160:BEGIN IF ABS(P)>=5*FONTSPACE[CURFONT]THEN VV:=TRUNC(
CONV*(V+P)+0.5)ELSE VV:=VV+TRUNC(CONV*(P)+0.5);
IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','down',O-156:0,' ',P:0);END;GOTO 44;END;
161,162,163,164,165:BEGIN Y:=P;
IF ABS(P)>=5*FONTSPACE[CURFONT]THEN VV:=TRUNC(CONV*(V+P)+0.5)ELSE VV:=VV
+TRUNC(CONV*(P)+0.5);IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','y',O-161:0,' ',P:0);END;GOTO 44;END;
166,167,168,169,170:BEGIN Z:=P;
IF ABS(P)>=5*FONTSPACE[CURFONT]THEN VV:=TRUNC(CONV*(V+P)+0.5)ELSE VV:=VV
+TRUNC(CONV*(P)+0.5);IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','z',O-166:0,' ',P:0);END;GOTO 44;END;
240:BEGIN IF NOT SHOWING THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','pst occurred before eop');
END ELSE WRITE(' ','pst occurred before eop');GOTO 9998;END;
241,242,243,244,245,246,247,248,249,250,251,252,253,254,255:BEGIN IF NOT
SHOWING THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','undefined command ',O:0,'!');
END ELSE WRITE(' ','undefined command ',O:0,'!');GOTO 30;END;END;
44:{78}IF(V>0)AND(P>0)THEN IF V>2147483647-P THEN BEGIN IF NOT SHOWING
THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','arithmetic overflow! parameter changed from ',P:0,' to '
,2147483647-V:0);
END ELSE WRITE(' ','arithmetic overflow! parameter changed from ',P:0,
' to ',2147483647-V:0);P:=2147483647-V;END;
IF(V<0)AND(P<0)THEN IF-V>P+2147483647 THEN BEGIN IF NOT SHOWING THEN
BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','arithmetic overflow! parameter changed from ',P:0,' to '
,(-V)-2147483647:0);
END ELSE WRITE(' ','arithmetic overflow! parameter changed from ',P:0,
' to ',(-V)-2147483647:0);P:=(-V)-2147483647;END;
IF SHOWING THEN BEGIN WRITE(' v:=',V:0);IF P>=0 THEN WRITE('+');
WRITE(P:0,'=',V+P:0,', vv:=',VV:0);END;V:=V+P;
IF ABS(V)>MAXV THEN BEGIN IF NOT SHOWING THEN BEGIN FLUSHTEXT;
SHOWING:=TRUE;WRITE(A:0,': ','warning: |v|>',MAXV:0,'!');
END ELSE WRITE(' ','warning: |v|>',MAXV:0,'!');MAXV:=ABS(V);END;GOTO 30;
9998:DOOTHERS:=FALSE;30:END;{66}FUNCTION DOPAGE:BOOLEAN;
LABEL 41,42,43,45,46,30,9998,9999;VAR O:EIGHTBITS;P,Q:INTEGER;A:INTEGER;
S:INTEGER;SS:INTEGER;K:INTEGER;BADCHAR:BOOLEAN;BEGIN CURFONT:=NF;S:=0;
H:=0;V:=0;W:=0;X:=0;Y:=0;Z:=0;HH:=0;VV:=0;
WHILE TRUE DO{67}BEGIN A:=CURLOC;SHOWING:=FALSE;O:=GETBYTE;
P:=FIRSTPAR(O);
{68}IF O<128 THEN{74}BEGIN IF(O>32)AND(O<=126)THEN BEGIN OUTTEXT(P);
IF OUTMODE=2 THEN BEGIN SHOWING:=TRUE;WRITE(A:0,': ','setchar',P:0);END;
END ELSE IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','setchar',P:0);END;GOTO 41;
END ELSE CASE O OF 128,129,130,131:BEGIN IF OUTMODE>0 THEN BEGIN
FLUSHTEXT;SHOWING:=TRUE;WRITE(A:0,': ','set',O-127:0,' ',P:0);END;
GOTO 41;END;132:BEGIN IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','setrule');END;GOTO 42;END;
137:BEGIN IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','putrule');END;GOTO 42;END;
{70}138:BEGIN IF OUTMODE=2 THEN BEGIN SHOWING:=TRUE;
WRITE(A:0,': ','nop');END;GOTO 30;END;
139:BEGIN IF NOT SHOWING THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','bop occurred before eop');
END ELSE WRITE(' ','bop occurred before eop');GOTO 9998;END;
140:BEGIN IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','eop');END;
IF S<>0 THEN IF NOT SHOWING THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','stack not empty at end of page (level ',S:0,')!');
END ELSE WRITE(' ','stack not empty at end of page (level ',S:0,')!');
DOPAGE:=TRUE;GOTO 9999;END;141:BEGIN IF OUTMODE>0 THEN BEGIN FLUSHTEXT;
SHOWING:=TRUE;WRITE(A:0,': ','push');END;
IF S=MAXSTACKDEPT THEN IF NOT SHOWING THEN BEGIN FLUSHTEXT;
SHOWING:=TRUE;WRITE(A:0,': ','deeper than claimed in postamble!');
END ELSE WRITE(' ','deeper than claimed in postamble!');
IF S=STACKSIZE THEN BEGIN IF NOT SHOWING THEN BEGIN FLUSHTEXT;
SHOWING:=TRUE;
WRITE(A:0,': ','DVItype capacity exceeded (stack size=',STACKSIZE:0,')')
;
END ELSE WRITE(' ','DVItype capacity exceeded (stack size=',STACKSIZE:0,
')');GOTO 9998;END;HSTACK[S]:=H;VSTACK[S]:=V;WSTACK[S]:=W;XSTACK[S]:=X;
YSTACK[S]:=Y;ZSTACK[S]:=Z;HHSTACK[S]:=HH;VVSTACK[S]:=VV;S:=S+1;SS:=S-1;
GOTO 45;END;142:BEGIN IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','pop');END;
IF S=0 THEN IF NOT SHOWING THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','(illegal at level zero)!');
END ELSE WRITE(' ','(illegal at level zero)!')ELSE BEGIN S:=S-1;
HH:=HHSTACK[S];VV:=VVSTACK[S];H:=HSTACK[S];V:=VSTACK[S];W:=WSTACK[S];
X:=XSTACK[S];Y:=YSTACK[S];Z:=ZSTACK[S];END;SS:=S;GOTO 45;END;
{71}143,144,145,146:BEGIN IF ABS(P)>=FONTSPACE[CURFONT]THEN BEGIN
OUTTEXT(32);HH:=TRUNC(CONV*(H+P)+0.5);
END ELSE HH:=HH+TRUNC(CONV*(P)+0.5);
IF OUTMODE=2 THEN BEGIN SHOWING:=TRUE;
WRITE(A:0,': ','right',O-142:0,' ',P:0);END;Q:=P;GOTO 43;END;
147,148,149,150,151:BEGIN W:=P;
IF ABS(P)>=FONTSPACE[CURFONT]THEN BEGIN OUTTEXT(32);
HH:=TRUNC(CONV*(H+P)+0.5);END ELSE HH:=HH+TRUNC(CONV*(P)+0.5);
IF OUTMODE=2 THEN BEGIN SHOWING:=TRUE;
WRITE(A:0,': ','w',O-147:0,' ',P:0);END;Q:=P;GOTO 43;END;
152,153,154,155,156:BEGIN X:=P;
IF ABS(P)>=FONTSPACE[CURFONT]THEN BEGIN OUTTEXT(32);
HH:=TRUNC(CONV*(H+P)+0.5);END ELSE HH:=HH+TRUNC(CONV*(P)+0.5);
IF OUTMODE=2 THEN BEGIN SHOWING:=TRUE;
WRITE(A:0,': ','x',O-152:0,' ',P:0);END;Q:=P;GOTO 43;END;
171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,
189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,
207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,
225,226,227,228,229,230,231,232,233,234:BEGIN IF OUTMODE>0 THEN BEGIN
FLUSHTEXT;SHOWING:=TRUE;WRITE(A:0,': ','fntnum',P:0);END;GOTO 46;END;
235,236,237,238:BEGIN IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','fnt',O-234:0,' ',P:0);END;GOTO 46;END;
239:{73}BEGIN IF OUTMODE>0 THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','xxx''');END;BADCHAR:=FALSE;
FOR K:=1 TO P DO BEGIN Q:=GETBYTE;
IF(Q>=33)AND(Q<=126)THEN BEGIN IF SHOWING THEN WRITE(XCHR[Q]);
END ELSE BADCHAR:=TRUE;END;IF SHOWING THEN WRITE('''');
IF BADCHAR THEN IF NOT SHOWING THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','non-ascii character in xxx command!');
END ELSE WRITE(' ','non-ascii character in xxx command!');GOTO 30;END;
OTHERS:IF DOOTHERS(O,P,A)THEN GOTO 30 ELSE GOTO 9998;END;
41:{75}IF FONTEC[CURFONT]=256 THEN P:=256;
IF(P<FONTBC[CURFONT])OR(P>FONTEC[CURFONT])THEN Q:=2147483647 ELSE Q:=
WIDTH[WIDTHBASE[CURFONT]+P];
IF Q=2147483647 THEN BEGIN IF NOT SHOWING THEN BEGIN FLUSHTEXT;
SHOWING:=TRUE;WRITE(A:0,': ','character ',P:0,' invalid in font ');
END ELSE WRITE(' ','character ',P:0,' invalid in font ');
PRINTFONT(CURFONT);IF CURFONT<>NF THEN WRITE('!');END;
IF O>=133 THEN GOTO 30;
IF Q=2147483647 THEN Q:=0 ELSE HH:=HH+PIXELWIDTH[WIDTHBASE[CURFONT]+P];
GOTO 43;42:{76}Q:=SIGNEDQUAD;
IF SHOWING THEN BEGIN WRITE(' height ',P:0,', width ',Q:0);
IF(P<=0)OR(Q<=0)THEN WRITE(' (invisible)')ELSE WRITE(' (',RULEPIXELS(P):
0,'x',RULEPIXELS(Q):0,' pixels)');END;IF O=137 THEN GOTO 30;
HH:=HH+RULEPIXELS(Q);GOTO 43;
43:{77}IF(H>0)AND(Q>0)THEN IF H>2147483647-Q THEN BEGIN IF NOT SHOWING
THEN BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','arithmetic overflow! parameter changed from ',Q:0,' to '
,2147483647-H:0);
END ELSE WRITE(' ','arithmetic overflow! parameter changed from ',Q:0,
' to ',2147483647-H:0);Q:=2147483647-H;END;
IF(H<0)AND(Q<0)THEN IF-H>Q+2147483647 THEN BEGIN IF NOT SHOWING THEN
BEGIN FLUSHTEXT;SHOWING:=TRUE;
WRITE(A:0,': ','arithmetic overflow! parameter changed from ',Q:0,' to '
,(-H)-2147483647:0);
END ELSE WRITE(' ','arithmetic overflow! parameter changed from ',Q:0,
' to ',(-H)-2147483647:0);Q:=(-H)-2147483647;END;
IF SHOWING THEN BEGIN WRITE(' h:=',H:0);IF Q>=0 THEN WRITE('+');
WRITE(Q:0,'=',H+Q:0,', hh:=',HH:0);END;H:=H+Q;
IF ABS(H)>MAXH THEN BEGIN IF NOT SHOWING THEN BEGIN FLUSHTEXT;
SHOWING:=TRUE;WRITE(A:0,': ','warning: |h|>',MAXH:0,'!');
END ELSE WRITE(' ','warning: |h|>',MAXH:0,'!');MAXH:=ABS(H);END;GOTO 30;
45:{79}IF SHOWING THEN BEGIN WRITELN(' ');
WRITE('level ',SS:0,':(h=',H:0,',v=',V:0,',w=',W:0,',x=',X:0,',y=',Y:0,
',z=',Z:0,',hh=',HH:0,',vv=',VV:0,')');END;GOTO 30;
46:{80}FONTNUM[NF]:=P;CURFONT:=0;
WHILE FONTNUM[CURFONT]<>P DO CURFONT:=CURFONT+1;
IF SHOWING THEN BEGIN WRITE(' current font is ');PRINTFONT(CURFONT);END;
30:IF SHOWING THEN WRITELN(' ');END;9998:WRITELN('!');DOPAGE:=FALSE;
9999:END;{100}BEGIN INITIALIZE;DIALOG;{84}OPENDVIFILE;PSTLOC:=-1;
STARTLOC:=-1;PAGECOUNT:=0;IF TRUE THEN BEGIN{85}N:=DVILENGTH;
IF N<42 THEN BEGIN WRITE(' ','Bad DVI file: ','only ',N:0,' bytes long',
'!');GOTO 9999;END;M:=N-4;
REPEAT IF M=0 THEN BEGIN WRITE(' ','Bad DVI file: ','all 223s','!');
GOTO 9999;END;MOVETOBYTE(M);K:=GETBYTE;M:=M-1;UNTIL K<>223;
IF K<>2 THEN BEGIN WRITE(' ','Bad DVI file: ','ID byte is ',K:0,'!');
GOTO 9999;END;MOVETOBYTE(M-3);Q:=SIGNEDQUAD;
IF(Q<0)OR(Q>M-36)THEN BEGIN WRITE(' ','Bad DVI file: ','pst pointer ',Q:
0,' at byte ',M-3:0,'!');GOTO 9999;END;MOVETOBYTE(Q);K:=GETBYTE;
IF K<>240 THEN BEGIN WRITE(' ','Bad DVI file: ','byte ',Q:0,
' is not pst','!');GOTO 9999;END;PSTLOC:=Q;{86}REPEAT P:=SIGNEDQUAD;
IF(P>Q-46)AND(P>=0)THEN BEGIN WRITE(' ','Bad DVI file: ','page link ',P:
0,' after byte ',Q:0,'!');GOTO 9999;END;IF P>=0 THEN BEGIN Q:=P;
MOVETOBYTE(Q);K:=GETBYTE;
IF K=139 THEN PAGECOUNT:=PAGECOUNT+1 ELSE BEGIN WRITE(' ',
'Bad DVI file: ','byte ',Q:0,' is not bop','!');GOTO 9999;END;
FOR K:=0 TO 9 DO COUNT[K]:=SIGNEDQUAD;IF STARTMATCH THEN STARTLOC:=Q;
END ELSE IF Q>0 THEN BEGIN MOVETOBYTE(0);
WHILE CURLOC<Q DO BEGIN K:=GETBYTE;
IF K<>138 THEN BEGIN WRITE(' ','Bad DVI file: ','byte ',CURLOC-1:0,
' is not nop','!');GOTO 9999;END;END;END;UNTIL P<0;MOVETOBYTE(PSTLOC+5);
END ELSE BEGIN{87}REPEAT IF EOF(DVIFILE)THEN K:=0 ELSE K:=GETBYTE;
UNTIL K<>138;IF(K<>139)AND(K<>240)THEN BEGIN WRITE(' ','Bad DVI file: ',
'first non-nop byte is ',K:0,'!');GOTO 9999;END;P:=-1;
WHILE PSTLOC<0 DO BEGIN M:=FIRSTPAR(K);
IF K=139 THEN{88}BEGIN PAGECOUNT:=PAGECOUNT+1;
FOR K:=0 TO 9 DO COUNT[K]:=SIGNEDQUAD;
IF(STARTLOC<0)AND STARTMATCH THEN STARTLOC:=CURLOC-41;
{89}BEGIN K:=SIGNEDQUAD;
IF K<>P THEN BEGIN WRITE(' ','Bad DVI file: ','backpointer in byte ',
CURLOC-4:0,' should be ',P:0,'!');GOTO 9999;END;END;P:=CURLOC-45;
END ELSE IF(K=132)OR(K=137)THEN M:=SIGNEDQUAD ELSE IF K=240 THEN PSTLOC
:=CURLOC-1 ELSE IF K=239 THEN FOR K:=1 TO M DO N:=GETBYTE;
IF EOF(DVIFILE)THEN BEGIN WRITE(' ','Bad DVI file: ',
'postamble unfindable','!');GOTO 9999;END;IF PSTLOC<0 THEN K:=GETBYTE;
END;{89}BEGIN K:=SIGNEDQUAD;
IF K<>P THEN BEGIN WRITE(' ','Bad DVI file: ','backpointer in byte ',
CURLOC-4:0,' should be ',P:0,'!');GOTO 9999;END;END;END;
{90}BEGIN WRITELN('Postamble starts at byte ',PSTLOC:0,'.');
{91}N:=SIGNEDQUAD;M:=SIGNEDQUAD;
IF N<=0 THEN BEGIN WRITE(' ','Bad DVI file: ','numerator is ',N:0,'!');
GOTO 9999;END;
IF M<=0 THEN BEGIN WRITE(' ','Bad DVI file: ','denominator is ',M:0,'!')
;GOTO 9999;END;WRITELN('numerator/denominator=',N:0,'/',M:0);
CONV:=(N/254000.0)*(RESOLUTION/M);N:=SIGNEDQUAD;
IF NEWMAG>0 THEN N:=NEWMAG ELSE IF N<=0 THEN BEGIN WRITE(' ',
'Bad DVI file: ','magnification is ',N:0,'!');GOTO 9999;END;
CONV:=CONV*(N/1000.0);
WRITELN('magnification=',N:0,'; ',CONV:16:8,' pixels per DVI unit');
MAXV:=SIGNEDQUAD;MAXH:=SIGNEDQUAD;MAXSTACKDEPT:=GETTWOBYTES;
WRITE('maxv=',MAXV:0,', maxh=',MAXH:0,', maxstackdepth=',MAXSTACKDEPT:0)
;M:=GETTWOBYTES;WRITE(', totalpages=',M:0);
IF M=PAGECOUNT THEN WRITELN(' ')ELSE WRITELN(' (should be',PAGECOUNT:0,
'!)');{93}FONTNUM[NF]:=SIGNEDQUAD;
WHILE FONTNUM[NF]<>-1 DO BEGIN IF EOF(DVIFILE)THEN BEGIN WRITE(' ',
'Bad DVI file: ','endless font definitions','!');GOTO 9999;END;
IF NF=MAXFONTS THEN BEGIN WRITE(' ',
'DVItype capacity exceeded (max fonts=',MAXFONTS:0,')!');GOTO 9999;END;
WRITE('Font ',FONTNUM[NF]:0,': ');M:=SIGNEDQUAD;Q:=SIGNEDQUAD;
{94}P:=GETBYTE;N:=GETBYTE;
IF FONTNAME[NF]+N+P>NAMESIZE THEN BEGIN WRITE(' ',
'DVItype capacity exceeded (name size=',NAMESIZE:0,')!');GOTO 9999;END;
IF N+P=0 THEN BEGIN WRITE(' ','Bad DVI file: ','null font name','!');
GOTO 9999;END;FONTNAME[NF+1]:=FONTNAME[NF]+N+P;
FOR K:=FONTNAME[NF]TO FONTNAME[NF+1]-1 DO BEGIN R:=GETBYTE;
IF(R<32)OR(R>126)THEN NAMES[K]:=63 ELSE NAMES[K]:=R;END;NF:=NF+1;
PRINTFONT(NF-1);NF:=NF-1;{97}FOR K:=1 TO NAMELENGTH DO CURNAME[K]:=' ';
R:=0;FOR K:=FONTNAME[NF]+P TO FONTNAME[NF+1]-1 DO BEGIN R:=R+1;
IF R+4>NAMELENGTH THEN BEGIN WRITE(' ','Font name is too long!');
GOTO 9999;END;
IF(NAMES[K]>=97)AND(NAMES[K]<=122)THEN CURNAME[R]:=XCHR[NAMES[K]-32]ELSE
CURNAME[R]:=XCHR[NAMES[K]];END;CURNAME[R+1]:='.';CURNAME[R+2]:='T';
CURNAME[R+3]:='F';CURNAME[R+4]:='M';R:=R+4;
IF P=0 THEN FOR K:=1 TO 9 DO BEGIN R:=R+1;
IF R>NAMELENGTH THEN BEGIN WRITE(' ','Font name is too long!');
GOTO 9999;END;CURNAME[R]:=DEFAULTDIREC[K];
END ELSE FOR K:=FONTNAME[NF]TO FONTNAME[NF]+P-1 DO BEGIN R:=R+1;
IF R>NAMELENGTH THEN BEGIN WRITE(' ','Font name is too long!');
GOTO 9999;END;
IF(NAMES[K]>=97)AND(NAMES[K]<=122)THEN CURNAME[R]:=XCHR[NAMES[K]-32]ELSE
CURNAME[R]:=XCHR[NAMES[K]];END;{98}K:=0;
WHILE FONTNUM[K]<>FONTNUM[NF]DO K:=K+1;
IF K<NF THEN WRITELN('---not loaded, this number already used!')ELSE
BEGIN OPENTFMFILE;
IF EOF(TFMFILE)THEN WRITELN('---not loaded, TFM file can''t be opened!')
ELSE BEGIN IF(Q<=0)OR(Q>=134217728)THEN WRITELN(
'---not loaded, bad scale (',Q:0,')!')ELSE IF INTFM(Q)THEN{99}BEGIN
FONTSPACE[NF]:=Q DIV 6;
IF(M<>0)AND(TFMCHECKSUM<>0)AND(M<>TFMCHECKSUM)THEN BEGIN WRITELN(
'---loaded but beware: check sums do not agree!');
WRITELN('   (',M:0,' vs. ',TFMCHECKSUM:0,')');
END ELSE WRITELN('---loaded at size ',Q:0,' DVI units');NF:=NF+1;END;
END;END;FONTNUM[NF]:=SIGNEDQUAD;END;{92}Q:=SIGNEDQUAD;
IF Q<>PSTLOC THEN WRITELN('pst pointer in byte ',CURLOC-4:0,
' should be ',PSTLOC:0,'!');M:=GETBYTE;
IF M<>2 THEN WRITELN('identification in byte ',CURLOC-1:0,' should be ',
2:0,'!');K:=CURLOC;M:=223;WHILE(M=223)AND NOT EOF(DVIFILE)DO M:=GETBYTE;
IF NOT EOF(DVIFILE)THEN WRITELN('signature in byte ',CURLOC-1:0,
' should be 223!')ELSE IF CURLOC<K+4 THEN WRITELN(
'not enough signature bytes at end of file (',CURLOC-K:0,')');;END;
IF STARTLOC<0 THEN WRITELN('The starting page could not be found!')ELSE
BEGIN IF TRUE THEN MOVETOBYTE(STARTLOC)ELSE BEGIN OPENDVIFILE;
WHILE CURLOC<STARTLOC DO N:=GETBYTE;END;
{101}WHILE MAXPAGES>0 DO BEGIN MAXPAGES:=MAXPAGES-1;REPEAT K:=GETBYTE;
UNTIL K<>138;IF K=240 THEN GOTO 9999;
IF K<>139 THEN BEGIN WRITE(' ','Bad DVI file: ','command at byte ',
CURLOC-1:0,' is not bop','!');GOTO 9999;END;WRITELN(' ');
WRITE(CURLOC-1:0,': beginning of page ');
FOR K:=0 TO STARTVALS DO BEGIN WRITE(SIGNEDQUAD:0);
IF K<STARTVALS THEN WRITE('.')ELSE WRITELN(' ');END;
FOR K:=STARTVALS+1 TO 10 DO N:=SIGNEDQUAD;
IF NOT DOPAGE THEN BEGIN WRITE(' ','page ended unexpectedly!');
GOTO 9999;END;END;END;9999:END.